perm filename UNDER[POX,WD]2 blob
sn#363244 filedate 1978-06-18 generic text, type T, neo UTF8
\|\\; Define Brick Character
\M0FIX25;\; fixed font
\⊂'000040;\; VERREM - REM's syntax form macros with args definitions
\⊂'000400;\; VERRHT - modified way to pass args with nest chars
\8EVAL(STRING)[⊗STRING⊗]\;
\8OMIT(STRING)[]\;
\8SETOM(REG)[\P\←=1;\→⊗REG⊗\p]\; set REG to one
\8SETZM(REG)[\P\←=0;\→⊗REG⊗\p]\; set REG to zero
\8LOADAC(VAR)[\!EVAL((\←=)\!⊗VAR⊗;(;));]\; load ac with var
\∞TRACEAC[\!EVAL((\m{)(ac=)\D∀( )(}));]\; trace ac
\;
\8INCR(VAR)[\N increment variable
\ ;\P\N save ac
\ ;\!LOADAC(⊗VAR⊗);\N load ac with var
\ ;\!EVAL((\∂←)⊗VAR⊗(;));\N expunge old var def
\ ;\+=1;\N add 1 to ac
\ ;\!EVAL((\∞)⊗VAR⊗([)\D∀(]));\N
\ ;\N redefine var
\ ;\p]\; restore ac
\;
\8COMPAC(ARG)[\N complement ac
\ ;\!EVAL(⊗ARG⊗);\N evaluate argument
\ ;\Q0\N save reg 0
\ ;\!SETOM(0);\N put a 1 in reg 0
\ ;\?SETZM(0);\N if ac > 0 set reg 0 to 0
\ ;\←0\N load ac from reg 0
\ ;\q0]\; restore reg 0
\;
\∞ISACZERO[\N is ac zero
\ ;\Q0\N save qreg 0
\ ;\→0\N store ac in 0
\ ;\*0\N mult ac by qreg 0
\ ;\!COMPAC;\N complement ac
\ ;\q0]\; restore qreg 0
\;
\8LENGTH(STRING)[\N length of string
\ ;\Q0\N save reg 0
\ ;\oSP{0 }\N put a space in an overlay
\ ;\7SP;\N width of space to ac
\ ;\∂←SP;\N expunge overlay
\ ;\→0\N store ac in reg 0
\ ;\oSTR{0 ⊗STRING⊗}\N put string in overlay
\ ;\7STR;\N width of string to ac
\ ;\∂←STR;\N expunge overlay
\ ;\-0\N subtract off width of space
\ ;\/0\N divide by width of space
\ ;\q0]\; restore reg 0
\;
\8NULL(STRING)[\!COMPAC(\!LENGTH(⊗STRING⊗););]\N
\;
\8FIRST(STRING)[\N first character of a string
\ ;\P\N save ac
\ ;\!OMIT(\a⊗STRING⊗);\N ascii of 1st char to ac
\ ;\N and flush rest of string
\ ;\A∀\N make char from ac
\ ;\p]\; restore ac
\;
\8REST(STRING)[\N rest of a string
\ ;\P\N save ac
\ ;\a⊗STRING⊗\N carve off 1st char
\ ;\p]\; restore ac
\;
\8MAPFIRST(MAC,STR)[\N apply macro to each char of string
\ ;\P\N save ac
\ ;\!COMPAC(\!NULL(⊗STR⊗););\N if string is not null
\ ;\?⊗MAC⊗(\?FIRST(⊗STR⊗););\N
\ ;\N apply macro to first char
\ ;\?MAPFIRST(⊗MAC⊗,\?REST(⊗STR⊗););\N
\ ;\N apply macro to rest of string
\ ;\p]\; restore ac
\;
\8ISCRLF(CHAR)[\N is char a cr or lf
\ ;\a⊗CHAR⊗\N ascii of char to ac
\ ;\P\N push ac
\ ;\-=13;\N sub ascii of cr from ac
\ ;\!COMPAC(\!ISACZERO;);\N was it a cr
\ ;\?EVAL((\p\N get back ascii of char
\ ;\-=10;\N sub ascii of lf
\ ;\!COMPAC(\!ISACZERO;);));\N was it a lf
\ ;\!COMPAC;]\; restore pos logic
\;
\8UNDERLINE(STR)[\!MAPFIRST(UNDERLINECHAR,⊗STR⊗);]\;
\;
\8UNDERLINECHAR(CHAR)[\N underline non crlf chars
\ ;\P\N save ac
\ ;\!COMPAC(\!ISCRLF(⊗CHAR⊗););\N if not cr or lf
\ ;\?UNDERLINECHAR1(⊗CHAR⊗);\N underline it
\ ;\!COMPAC;\N complement ac
\ ;\?INCR(UNDCNT);\N
\ ;\?EVAL(⊗CHAR⊗);\N pass bare char
\ ;\p]\; restore ac
\;
\8UNDERLINECHAR1(CHAR)[\[=2;=2;⊗CHAR⊗\]]\;
\8UNDERLINECHAR1(CHAR)[\N *****
\ ;\[=2;=2;⊗CHAR⊗\]\N
\ ;\!INCR(UNDCNT);
\!EVAL((\m{)\!UNDCNT;( )(}));]\;
\∞UNDCNT[0]\; *****
\;
\∞FOO[\N macro to iterate underline
\ ;\-=1;\N decrement count
\ ;\P\N
\ ;\!UNDERLINE(a);\N
\ ;\p]\;
\←=1000;\; iteration count
\IFOO;\;
\8PRINTCHARS(STR)[\!MAPFIRST(PRINTCHAR,⊗STR⊗);]\;
\;
\8PRINTCHAR(CH)[
\ ;\P\N save ac
\ ;\a⊗CH⊗\N ascii of char to ac
\ ;\!EVAL((\m{)\D∀( )(}));\N trace ac
\ ;\!ISCRLF(⊗CH⊗);\N
\ ;\!EVAL((\m{)\D∀( )(}));\N trace ac
\ ;\p]\; restore ac
\;